perm filename REGION.FAI[XGP,BGB] blob
sn#036591 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE REGION CONVERT POLYGONS TO REGION BIT ARRAY. 29 JANUARY 1973.
C00007 00003 SUBR(REGION)-------------------------------------------------------
C00011 00004 SUBR(MKPEAK)-------------------------------------------------------
C00013 00005 SUBR(MKSCAN)-------------------------------------------------------
C00015 00006 SUBR(MKSEGS)-------------------------------------------------------
C00017 00007 FISSION---------------------------------------------------
C00020 00008 SUBR(FILL)---------------------------------------------------------
C00022 00009 SUBR(KLSEGS)-------------------------------------------------------
C00025 00010 SUBR(KLSEG)SEG-----------------------------------------------------
C00027 00011 SUBR(LTXING)SEG----------------------------------------------------
C00029 00012 SUBR(RTXING)SEG----------------------------------------------------
C00031 00013 END
C00033 ENDMK
C⊗;
TITLE REGION; CONVERT POLYGONS TO REGION BIT ARRAY. 29 JANUARY 1973.
COMMENT/
The ten subroutines of this file compute the region of a bit
array corresponding to the interior of a CRE polygon vector image.
REGION; MAIN CALL - MAKE REGION FROM FIRST IMAGE OF THE FILM.
MKPEAK(PGON1); MAKE RING OF PEAKS OF POLYGON.
MKSCAN; FILL ALL SCAN LINES OF PEAKS' RING.
MKSEGS; SEGMENT MAKES AND FISSIONS.
FILL; FILL ONE SCAN LINE INTO PAK ARRAY.
KLSEGS; SEGMENT KILLS AND FUSIONS.
KLPEAK(PEAK); KILL PEAK FROM RING OF PEAKS.
KLSEG(SEG); KILL SEGMENT FROM RING OF SEGMENTS.
LTXING(SEG); SCAN FOR LEFT TERMINATOR CROSSING.
RTXING(SEG); SCAN FOR RIGHT TERMINATOR CROSSING.
/
;(ARC OF VERTEX → SEGMENT)
;0 CW CCW SCAN LINE RING
;1 ? ?
;2 TYPE 300003
;3 LDEL RDEL ;LEFT AND RIGHT DELTA COLUMN
;4 LCOL RCOL ;LEFT AND RIGHT COLUMN NUMBER
;5 LROW RROW ;LEFT AND RIGHT ROW OF TERMINATION
;6 LT RT ;LEFT AND RIGHT TERMINAL VECTORS
;segment node - defn: a segment is a portion of a scan line.
; DEFINE LDEL(A,Q){HLRZ A,3(Q)}↔DEFINE LDEL.(A,Q){HRLM A,3(Q)}
; DEFINE RDEL(A,Q){HRRZ A,3(Q)}↔DEFINE RDEL.(A,Q){HRRM A,3(Q)}
DEFINE LDEL(A,Q){HLRE A,3(Q)}↔DEFINE LDEL.(A,Q){HRLM A,3(Q)}
DEFINE RDEL(A,Q){HRRE A,3(Q)}↔DEFINE RDEL.(A,Q){HRRM A,3(Q)}
DEFINE LCOL(A,Q){HLRE A,4(Q)}↔DEFINE LCOL.(A,Q){HRLM A,4(Q)}
DEFINE RCOL(A,Q){HRRE A,4(Q)}↔DEFINE RCOL.(A,Q){HRRM A,4(Q)}
DEFINE LROW(A,Q){HLRE A,5(Q)}↔DEFINE LROW.(A,Q){HRLM A,5(Q)}
DEFINE RROW(A,Q){HRRE A,5(Q)}↔DEFINE RROW.(A,Q){HRRM A,5(Q)}
DEFINE LT (A,Q){HLRZ A,6(Q)}↔DEFINE LT. (A,Q){HRLM A,6(Q)}
DEFINE RT (A,Q){HRRZ A,6(Q)}↔DEFINE RT. (A,Q){HRRM A,6(Q)}
;VARIABLES GLOBAL TO THE SUBROUTINES IN THIS FILE.
PEAK0: 0 ;ORDERED RING OF PEAK VERTICES.
SEG0: 0 ;ORDERED RING OF SEGMENTS.
ROW0: 0 ;CURRENT SCAN LINE ROW POSITION.
PAKBIT: 0 ;BIT FOR REGION PACKING.
PAK: 0 ;PICTURE ACCUMULATOR 216 ROWS OF 288 BITS/ROW.
BLOCK =1728
PAKEND←←.-1
PAKPTR: ;PAK COLUMN BIT ADDRESS VECTOR.
RADIX 12
FOR I←0,7{
FOR J←0,=35{POINT 1,PAK+I(2),J
}}↔RADIX 8
DECLARE{RMIN,RMAX,CMIN,CMAX,DEBUG}
$←400000
EXTERN MAKE,KILL,FILM,ARCVIC,KLARCL,DPYSGS,DPYSEG,SEGFNT,XYMOVE,LIMITS,CNTFLG
INTERN RMIN,RMAX,CMIN,CMAX,DEBUG,ROW0,PAK,PAKPTR
SUBR(REGION)-------------------------------------------------------
BEGIN REGION;MAKE REGION BIT ARRAY OF FIRST IMAGE OF THE FILM.
;BGB - 30 JANUARY 1973.
MOVE 1,FILM↔SON 1,1↔SKIPN 1↔POP0J ;IMAGE.
MOVEM 1,IMG#
SON 1,1↔JUMPE 1,[POP0J] ;LEVEL.
SON 1,1↔JUMPE 1,[ CALL(CLRPAK)↔POP0J ] ;POLYGON.
MOVEM 1,PGON0#↔MOVEM 1,PGON1#
;CLEAR PAK ARRAY.
CALL(CLRPAK)
SETZM SEG0 ;JUST IN CASE WE BLEW UP THE LAST TIME
SKIPN CNTFLG
GO L0A
CALL(LIMITS)
MOVE 5,[XWD -4,1]↔MOVEI 0,77
SETCMI 6,37
L0: ANDM 0,(5)↔TDNE 6,(5)
ORM 6,(5)↔AOBJN 5,L0
ADD 1,2↔ADD 3,4↔ ;AVERAGE THEM
ASH 1,-1↔ASH 3,-1
ADDI 1,40↔ADDI 3,40
MOVEM 1,DELX#↔MOVEM 3,DELY# ;REMEMBER OFFSET
MOVN 1,1↔MOVN 3,3 ;CENTER IT WITH RESPECT TO GRID
CALL(XYMOVE,IMG,1,3) ;DO ACTUAL MOVING
;BLOB POLYONS TO SCAN BIT ARRAY.
L0A: SETOM PAKBIT
L1: MOVE 1,PGON1↔TEST 1,HOLBIT↔GO L2
CALL(ZIPARC,PGON1)
CALL(MKPEAK,PGON1)
CALL(MKSCAN)
CALL(RSTARC,PGON1)
L2: MOVE 1,PGON1↔CCW 1,1↔MOVEM 1,PGON1
CAME 1,PGON0↔GO L1
;HOLE POLYGONS TO BIT SCAN ARRAY.
SETZM PAKBIT
L3: MOVE 1,PGON1↔TESTZ 1,HOLBIT↔GO L4
CALL(ZIPARC,PGON1)
CALL(MKPEAK,PGON1)
CALL(MKSCAN)
CALL(RSTARC,PGON1)
L4: MOVE 1,PGON1↔CCW 1,1↔MOVEM 1,PGON1
CAME 1,PGON0↔GO L3
EXTERN DPYPAK↔CALL(DPYPAK)
SKIPN CNTFLG
POP0J
CALL(XYMOVE,IMG,DELX,DELY) ;PUT IMAGE BACK IN ITS PLACE
POP0J
BEND;1/31/73------------------------------------------------------
SUBR(ZIPARC)PGON---------------------------------------------------
MOVE 1,ARG1↔SON 1,1↔MOVEM 1,2↔SETZ
ARC. 0,1↔CCW 1,1↔CAME 1,2↔GO .-3
POP1J
;2/3/73-----------------------------------------------------------
SUBR(RSTARC)PGON--------------------------------------------------
;RESTORE ARC POINTERS
MOVE 1,ARG1↔ARC 1,1
TEST 1,ARCBIT↔POP1J
MOVE 0,1
LOOP: ARC 2,1↔ARC. 1,2
CCW 1,1↔CAME 0,1↔GO LOOP
POP1J
;24-MAR-73(TVR)---------------------------------------------------
SUBR CLRPAK
SETZM PAK↔MOVE[XWD PAK,PAK+1]↔BLT PAK+=1727
SETZM CMAX↔SETZM RMAX
MOVEI =288↔MOVEM CMIN
MOVEI =216↔MOVEM RMIN
POP0J
;30-MAR-73(TVR)---------------------------------------------------
SUBR(MKPEAK)-------------------------------------------------------
BEGIN MKPEAK;MAKE ORDERED RING OF PEAK VERTICES OF A POLYGON.
;BGB - 30 JANUARY 1973.
ACCUMULATORS{PG,V0,V1,V2,R0,R1,R2}
;UPPERMOST LEFT IS ALWAYS THE FIRST PEAK VERTEX.
MOVE PG,ARG1↔SON V1,PG
MOVEM V1,PEAK0↔MARK V1,TMPBIT
HRLM V1,6(V1)↔HRRM V1,6(V1)
ROW R1,V1
CCW V2,V1↔ROW R2,V2
;ADVANCE CCW TO NEXT VECTOR.
L1: MOVE V0,V1↔MOVE R0,R1
MOVE V1,V2↔MOVE R1,R2
CCW V2,V2↔ROW R2,V2
CAMN V1,PEAK0↔POP1J ;EXIT
;TEST V1 FOR PEAK'ED'NESS.
CAMLE R1,R0↔GO L1
CAMLE R1,R2↔GO L1
;SCAN UP THE PEAK RING FOR V1'S PLACE.
L2: MARK V1,TMPBIT;USE TMPBIT MARK FOR PEAK.
MOVE 2,PEAK0↔GO L3A
L3: CAMN 1,PEAK0↔GO [ OUTSTR[ASCIZ/POLYGON HAS WRONG SON.
/]↔ MOVEM V1,PEAK0↔GO L4 ]
MOVE 2,1
L3A: HLRZ 1,6(2)↔ROW 0,1
CAMLE 0,R1↔GO L3
;PLACE V1 INTO THE PEAKS RING.
L4: HRLM 1,6(V1)↔HRRM V1,6(1)
HRRM 2,6(V1)↔HRLM V1,6(2)
GO L1
BEND;1/31/73------------------------------------------------------
SUBR(MKSCAN)-------------------------------------------------------
BEGIN MKSCAN;MAKE ALL THE SCAN LINES IMPLIED BY THE PEAKS' RING.
;TOP PEAK OF THE POLYGON DETERMINES ROW0.
MOVE 1,PEAK0↔ROW 0,1
JUMPL 0,[ FATAL<THIS GLYPH IS OFF-SCREEN, PLEASE MOVE DOWN AND TRY AGAIN.>]
ANDCMI 0,77↔MOVEM 0,ROW0
;ADVANCE ROW0 UNTIL THE PEAK AND SEGMENT RINGS ARE EMPTY.
L1: MOVE PEAK0↔IOR SEG0
SKIPN↔POP0J
CALL(MKSEGS) ;START SEGMENTS - SEGMENT MAKES & FISSIONS.
CALL(FILL) ;RING OF SEGMENTS TO A ROW OF BITS.
SKIPE DEBUG
GO [ CALL(DPYSGS,SEG0)↔SETCM 1,DEBUG↔SKIPL 1↔SLEEP 1,↔GO C1 ]
C1:
MOVEI 100↔ADDM ROW0
CALL(KLSEGS) ;ADVANCE SEGMENTS - SEGMENT KILLS & FUSIONS.
GO L1
BEND;1/31/73------------------------------------------------------
SUBR(MKSEGS)-------------------------------------------------------
BEGIN MKSEGS;START SEGMENTS - SEGMENT MAKES & FISSIONS.
ACCUMULATORS{L,R,SEG2,SEG1,PK,PK2,SEG}
;TAKE THE PEAKS ABOVE THE CURRENT SCAN LINE.
L1: SKIPN PK,PEAK0↔POP0J
ROW 0,PK↔CAML 0,ROW0↔POP0J
CALL(KLPEAK,PK)
MOVEM PK,SAVEPK#
CW PK2,PK
;CREATE PROTO SEGMENT.
SETQ(SEG,{MAKE,[ARCBIT+EBIT+300003]})
CW. SEG,SEG↔CCW. SEG,SEG
LT. PK,SEG↔ARC. SEG,PK
; RT. PK2,SEG↔ARC. SEG,PK2
;FIND SCAN LINE CROSSINGS (IF ANY).
CALL(LTXING,SEG)
GO[CALL(KLSEG,SEG)↔GO L1]
MOVE PK,SAVEPK↔RT. PK,SEG
CALL(RTXING,SEG)
GO FUSION
;PLACE SEGMENT INTO THE ORDERED SEGMENT RING.
SKIPN 1,SEG0↔GO[MOVEM SEG,SEG0↔GO L1] ;SHINEY NEW RING.
LCOL L,SEG↔RCOL R,SEG
LDEL 0,SEG↔RDEL PK,SEG
CAMN L,R↔CAMGE 0,PK
CAMLE L,R↔GO L2 ;FISSION.
;NO FISSION.
LCOL L,1
CAMLE R,L↔GO[ ;SKIP ON RIGHT NEIGHBOR FOUND.
CCW 1,1↔CAME 1,SEG0↔GO .-2↔GO .+3]
CAMN 1,SEG0↔MOVEM SEG,SEG0 ;POSSIBLE NEW LEFTMOST.
CW 2,1
CW. 2,SEG↔CCW. 1,SEG
CCW. SEG,2↔CW. SEG,1
GO L1
FUSION: CAME 1,SEG↔JUMPN 1,FUSIO1
FATAL(UNEXPECTED SEGMENT DEATH - MKSEGS)
FUSIO1: LDEL 0,SEG↔LDEL. 0,1
LCOL 0,SEG↔LCOL. 0,1
LROW 0,SEG↔LROW. 0,1
LT L,SEG↔LT. L,1
SKIPE L ↔ARC. 1,L
CALL(KLSEG,SEG)
GO L1
COMMENT⊗ FISSION---------------------------------------------------
BEFORE: _____________SEG1____________
| _____________ |
| | SEG2 | |
LT RT LT RT
AFTER:
LT RT LT RT
| SEG1 | | SEG2 |
|_______| |_______|
;-----------------------------------------------------------------⊗
L2: MOVE 0,R↔ADD 0,L↔ASH 0,-1 ;MIDPOINT OF SEG2.
;L2: MOVE 1,SAVEPK↔COL 0,1 ;NOT THE MIDPOINT, USE THE PEAK
; SETZM FOOFLG# ;REMEMBER THIS IS FIRST TIME THRU
L2A: MOVE SEG2,SEG↔MOVE SEG1,SEG0
L3: LCOL L,SEG1↔RCOL R,SEG1
CAMG L,0↔CAMLE 0,R↔GO[ ;TEST FOR SEG2 WITHIN SEG1.
;ADVANCE OR BLOWUP.
CCW SEG1,SEG1↔CAME SEG1,SEG0↔GO L3
; SKIPN FOOFLG
; GO [ RDEL 1,SEG↔LDEL PK,SEG↔ADD 1,PK ;TRY ADDING AVERAGE OF
; ASH PK,-1↔ADD 0,1↔SETOM FOOFLG ;DELS AND SEARCH AGAIN
; OUTSTR[
;ASCIZ/INITIAL FISSION SEGMENT SEARCH LOST. WILL ADJUST AND TRY AGAIN.
;/]↔ GO L2A ]
; OUTSTR[ASCIZ/MKSEGS - DANGLING FISSION HOLE
;TYPE <RETURN> TO CONTINUE: /]
; INCHWL
; CAIE 15
; GO $.-2
; INCHRW
; CRLF
; CALL(KLSEG,SEG2)
; GO L1]
FATAL(DANGLING FISSION HOLE - MKSEGS)]
;SWAP RIGHT TERMINATORS.
RDEL 0,SEG1↔RDEL 1,SEG2↔RDEL. 1,SEG1↔RDEL. 0,SEG2
RCOL 0,SEG1↔RCOL 1,SEG2↔RCOL. 1,SEG1↔RCOL. 0,SEG2
RROW 0,SEG1↔RROW 1,SEG2↔RROW. 1,SEG1↔RROW. 0,SEG2
RT 1,SEG1↔ARC. SEG2,1
RT 2,SEG2↔ARC. SEG1,2
RT. 2,SEG1↔RT. 1,SEG2
;PLACE SEG2 INTO THE ORDERED SEGMENT RING CCW OF SEG1.
CCW 1,SEG1
CCW. 1,SEG2↔CW. SEG2,1
CW. SEG1,SEG2↔CCW. SEG2,SEG1
GO L1
BEND;1/31/73------------------------------------------------------
SUBR(FILL)---------------------------------------------------------
BEGIN FILL;FILL BITS INTO PAK MATRIX.
ACCUMULATORS{R,C1,C2,BIT,SEG}
SKIPN SEG,SEG0↔POP0J
MOVE BIT,PAKBIT
MOVE R,ROW0↔LSH R,-6
CAMLE R,RMAX↔MOVEM R,RMAX
CAMGE R,RMIN↔MOVEM R,RMIN
LSH R,3
L1: LCOL C1,SEG
RCOL C2,SEG
L1A: ADDI C1,40↔LSH C1,-6
ADDI C2,40↔LSH C2,-6
SKIPGE C1↔SETZ C1,
SKIPGE C2↔SETZ C2,
CAILE C1,=287↔MOVEI C1,=287
CAILE C2,=287↔MOVEI C2,=287
CAMLE C1,CMAX↔MOVEM C1,CMAX↔CAMGE C1,CMIN↔MOVEM C1,CMIN
CAMLE C2,CMAX↔MOVEM C2,CMAX↔CAMGE C2,CMIN↔MOVEM C2,CMIN
CAMLE C1,C2↔GO [ OUTSTR[ASCIZ/BACKWARD SEGMENT FOUND AT FILL!
/]↔ GO L2]
;L2: CAMLE C1,C2↔GO .+3
L2: CAML C1,C2↔GO .+3
DPB BIT,PAKPTR(C1)↔AOJA C1,L2
CCW SEG,SEG
CAME SEG,SEG0↔GO L1
POP0J
BEND;1/31/73------------------------------------------------------
SUBR(KLSEGS)-------------------------------------------------------
BEGIN KLSEGS;ADVANCE - SEGMENT KILLS AND FUSIONS.
SEG←16
SKIPN SEG,SEG0↔POP0J↔MOVEM SEG,SEGMEN#
GO L2
;UPDATE COLUMN LOCII.
L1: SKIPN SEG0↔POP0J
SKIPN SEG,SEGMEN↔POP0J
SKIPN 2(SEG)↔POP0J
CCW SEG,SEG↔CAMN SEG,SEG0↔POP0J
L2: LCOL 0,SEG↔LDEL 1,SEG↔ADD 0,1↔LT 2,SEG↔COL 2,2
JUMPL 1,[SOS 2↔CAMGE 0,2↔MOVEM 2,0↔GO .+4]
AOS 2↔CAMLE 0,2↔MOVEM 2,0
LCOL. 0,SEG
RCOL 0,SEG↔RDEL 1,SEG↔ADD 0,1↔RT 2,SEG↔COL 2,2
JUMPL 1,[SOS 2↔CAMGE 0,2↔MOVEM 2,0↔GO .+4]
AOS 2↔CAMLE 0,2↔MOVEM 2,0
RCOL. 0,SEG
MOVEM SEG,SEGMEN
;TEST FOR END OF LEFT TERMINATOR.
LROW 0,SEG↔CAMLE 0,ROW0↔GO L3
CALL(LTXING,SEG)↔SKIPA↔GO L3
;SEGMENT DEATH.
JUMPE 1,[ MOVE 1,SEG↔GO L2A ]
; CAME 1,SEGMEN↔GO[FATAL({KLSEGS - UNEXPECTED SEGMENT FUSION.})]
MOVE 1,SEGMEN
L2A: CCW 0,1↔CAMN 0,1↔SETZ↔MOVEM 0,SEGMEN
CALL(KLSEG,1)
SKIPN SEG0↔POP0J
SKIPN SEG,SEGMEN↔POP0J↔GO L2
;TEST FOR END OF RIGHT TERMINATOR.
L3: MOVE SEG,SEGMEN
RROW 0,SEG↔CAMLE 0,ROW0↔GO L1
CALL(RTXING,SEG)↔SKIPA↔GO L1
CAMN 1,SEGMEN↔GO[;FATAL({KLSEGS - UNEXPECTED SEGMENT DEATH})]
GO L2A ]
;SEGMENT FUSION - REPLACE RT(SEG) ← RT(SEG2).
RDEL 0,1↔RDEL. 0,SEG
RCOL 0,1↔RCOL. 0,SEG
RROW 0,1↔RROW. 0,SEG
RT 2,1↔RT. 2,SEG↔ARC. SEG,2
CALL(KLSEG,1)
GO L3 ;NOTA BENE ! WE HAVE YET TO DO THE RT OF THIS SEG.
BEND;1/31/73------------------------------------------------------
SUBR(KLSEG)SEG-----------------------------------------------------
BEGIN KLSEG;KILL SEGMENT - AC TRANSPARENT.
MOVEM 2,AC2↔MOVEM 3,AC3↔MOVE 3,ARG1
;CLEAN UP ARC LINKS.
SETZ↔LT 1,3↔ARC 2,1↔CAMN 2,3↔ARC. 0,1
SETZ↔RT 1,3↔ARC 2,1↔CAMN 2,3↔ARC. 0,1
;RING OUT AND KILL THE SEGMENT.
CW 1,3↔CCW 2,3
CCW. 2,1↔CW. 1,2
CAMN 1,3↔SETZ 2,
CAMN 3,SEG0↔MOVEM 2,SEG0
CALL(KILL,3)
MOVE 2,AC2↔MOVE 3,AC3
POP1J
BEND;1/31/73------------------------------------------------------
SUBR(KLPEAK)-------------------------------------------------------
BEGIN KLPEAK;KILL PEAK VERTEX - AC TRANSPARENT.
MOVEM 2,AC2↔MOVEM 3,AC3
MOVE 3,ARG1↔MARKZ 3,TMPBIT
HLRZ 1,6(3)↔HRRZ 2,6(3)↔SETZM 6(3)
HRRM 2,6(1)↔HRLM 1,6(2)
CAMN 2,3↔SETZ 2,
CAMN 3,PEAK0↔MOVEM 2,PEAK0
MOVE 2,AC2↔MOVE 3,AC3
POP1J
BEND;1/31/73------------------------------------------------------
SUBR(LTXING)SEG----------------------------------------------------
BEGIN LTXING;LEFT TERMINATOR CROSSING - BGB - 30 JANUARY 1973.
ACCUMULATORS{SEG,V0,V1,V2,R1,R2}
MOVE SEG,ARG1
LT V2,SEG↔ROW R2,V2↔MOVEM V2,V0
L1: MOVE V1,V2↔MOVE R1,R2 ;ADVANCE ALONG POLYGON'S PERIMETER.
CCW V2,V2↔ROW R2,V2
CAMN V2,V0↔GO[MOVE 1,SEG↔POP1J] ;EXIT NO CROSSING.
CAMLE R2,ROW0↔GO L2 ;ROW0 CROSSING TEST.
ARC 1,V2↔CAME 1,SEG ;DON'T LEAVE IF OWN SEGMENT
JUMPN 1,POP1J. ;EXIT SEGMENT FOUND.
TEST V2,TMPBIT↔GO L1 ;NO CROSSING YET.
CALL(KLPEAK,V2)↔GO L1 ;KILL SPURIOUS PEAK.
;NEW LEFT TERMINATOR.
L2: SETZ↔LT 1,SEG↔SKIPE 1↔ARC. 0,1 ;FLUSH OLD ARC POINTER
LT. V2,SEG↔ARC. SEG,V2 ;MAKE NEW ARC POINTER
LROW. R2,SEG ;LAST ROW.
;LDEL←(C2-C1)/(R2-R1).
COL 0,V2↔COL 1,V1
SUB 0,1↔ASH 0,6
; SUB R2,R1↔IDIV 0,R2
SUB R2,R1↔JUMPE R2,[FATAL(DIVISION BY ZERO AT LTXING)]
IDIV 0,R2
LDEL. 0,SEG
;LCOL ← R1+LDEL*(ROW0-R1)
MOVE 1,ROW0↔SUB 1,R1
IMUL 0,1↔ASH 0,-6
COL 1,V1↔ADD 0,1
; COL 0,V1
LCOL. 0,SEG
AOS(P)↔POP1J ;RETURN SKIP.
BEND;1/30/73------------------------------------------------------
SUBR(RTXING)SEG----------------------------------------------------
BEGIN RTXING;RIGHT TERMINATOR CROSSING - BGB - 30 JANUARY 1973.
ACCUMULATORS{SEG,V0,V1,V2,R1,R2}
MOVE SEG,ARG1
RT V2,SEG↔ROW R2,V2↔MOVEM V2,V0
L1: MOVE V1,V2↔MOVE R1,R2 ;ADVANCE ALONG POLYGON'S PERIMETER.
CW V2,V2↔ROW R2,V2
CAMN V2,V0↔GO[MOVE 1,SEG↔POP1J] ;EXIT NO CROSSING.
ARC 1,V2↔CAME 1,SEG ;DON'T LEAVE IF OWN SEGMENT
JUMPN 1,POP1J. ;EXIT SEGMENT FOUND.
CAMLE R2,ROW0↔GO L2 ;ROW0 CROSSING TEST.
TEST V2,TMPBIT↔GO L1 ;NO CROSSING YET.
CALL(KLPEAK,V2)↔GO L1 ;KILL SPURIOUS PEAK.
;NEW RIGHT TERMINATOR.
L2: SETZ↔RT 1,SEG↔SKIPE 1↔ARC. 0,1 ;FLUSH OLD ARC POINTER
RT. V2,SEG↔ARC. SEG,V2 ;MAKE NEW ARC POINTERS
RROW. R2,SEG ;LAST ROW.
;RDEL←(C2-C1)/(R2-R1).
COL 0,V2↔COL 1,V1
SUB 0,1↔ASH 0,6
; SUB R2,R1↔IDIV 0,R2
SUB R2,R1↔JUMPE R2,[FATAL(DIVISION BY ZERO AT RTXING)]
IDIV 0,R2
RDEL. 0,SEG
;RCOL ← R1+RDEL*(ROW0-R1)
MOVE 1,ROW0↔SUB 1,R1
IMUL 0,1↔ASH 0,-6
COL 1,V1↔ADD 0,1
; COL 0,V1
RCOL. 0,SEG
AOS(P)↔POP1J ;RETURN SKIP.
BEND;1/30/73------------------------------------------------------
END
EOF - REGION.